home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / RXPROPS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  27.4 KB  |  931 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit RXProps;
  13.  
  14. interface
  15.  
  16. {$I RX.INC}
  17.  
  18. uses SysUtils, Classes, Graphics, Controls, Forms, TypInfo, VclUtils;
  19.  
  20. type
  21.  
  22. { TPropInfoList }
  23.  
  24.   TPropInfoList = class(TObject)
  25.   private
  26.     FList: PPropList;
  27.     FCount: Integer;
  28.     FSize: Integer;
  29.     function Get(Index: Integer): PPropInfo;
  30.   public
  31.     constructor Create(AObject: TObject; Filter: TTypeKinds);
  32.     destructor Destroy; override;
  33.     function Contains(P: PPropInfo): Boolean;
  34.     function Find(const AName: string): PPropInfo;
  35.     procedure Delete(Index: Integer);
  36.     procedure Intersect(List: TPropInfoList);
  37.     property Count: Integer read FCount;
  38.     property Items[Index: Integer]: PPropInfo read Get; default;
  39.   end;
  40.  
  41. { TPropsStorage }
  42.  
  43.   TReadStrEvent = function(const ASection, Item, Default: string): string of object;
  44.   TWriteStrEvent = procedure(const ASection, Item, Value: string) of object;
  45.   TEraseSectEvent = procedure(const ASection: string) of object;
  46.  
  47.   TPropsStorage = class(TObject)
  48.   private
  49.     FObject: TObject;
  50.     FOwner: TComponent;
  51.     FPrefix: string;
  52.     FSection: string;
  53.     FOnReadString: TReadStrEvent;
  54.     FOnWriteString: TWriteStrEvent;
  55.     FOnEraseSection: TEraseSectEvent;
  56.     function StoreIntegerProperty(PropInfo: PPropInfo): string;
  57.     function StoreCharProperty(PropInfo: PPropInfo): string;
  58.     function StoreEnumProperty(PropInfo: PPropInfo): string;
  59.     function StoreFloatProperty(PropInfo: PPropInfo): string;
  60.     function StoreStringProperty(PropInfo: PPropInfo): string;
  61.     function StoreSetProperty(PropInfo: PPropInfo): string;
  62.     function StoreClassProperty(PropInfo: PPropInfo): string;
  63.     function StoreStringsProperty(PropInfo: PPropInfo): string;
  64.     function StoreComponentProperty(PropInfo: PPropInfo): string;
  65. {$IFDEF WIN32}
  66.     function StoreLStringProperty(PropInfo: PPropInfo): string;
  67.     function StoreWCharProperty(PropInfo: PPropInfo): string;
  68.     function StoreVariantProperty(PropInfo: PPropInfo): string;
  69.     procedure LoadLStringProperty(const S: string; PropInfo: PPropInfo);
  70.     procedure LoadWCharProperty(const S: string; PropInfo: PPropInfo);
  71.     procedure LoadVariantProperty(const S: string; PropInfo: PPropInfo);
  72. {$ENDIF}
  73. {$IFDEF RX_D4}
  74.     function StoreInt64Property(PropInfo: PPropInfo): string;
  75.     procedure LoadInt64Property(const S: string; PropInfo: PPropInfo);
  76. {$ENDIF}
  77.     procedure LoadIntegerProperty(const S: string; PropInfo: PPropInfo);
  78.     procedure LoadCharProperty(const S: string; PropInfo: PPropInfo);
  79.     procedure LoadEnumProperty(const S: string; PropInfo: PPropInfo);
  80.     procedure LoadFloatProperty(const S: string; PropInfo: PPropInfo);
  81.     procedure LoadStringProperty(const S: string; PropInfo: PPropInfo);
  82.     procedure LoadSetProperty(const S: string; PropInfo: PPropInfo);
  83.     procedure LoadClassProperty(const S: string; PropInfo: PPropInfo);
  84.     procedure LoadStringsProperty(const S: string; PropInfo: PPropInfo);
  85.     procedure LoadComponentProperty(const S: string; PropInfo: PPropInfo);
  86.     function CreateInfoList(AComponent: TComponent; StoredList: TStrings): TStrings;
  87.     procedure FreeInfoLists(Info: TStrings);
  88.   protected
  89.     function ReadString(const ASection, Item, Default: string): string; virtual;
  90.     procedure WriteString(const ASection, Item, Value: string); virtual;
  91.     procedure EraseSection(const ASection: string); virtual;
  92.     function GetItemName(const APropName: string): string; virtual;
  93.     function CreateStorage: TPropsStorage; virtual;
  94.   public
  95.     procedure StoreAnyProperty(PropInfo: PPropInfo);
  96.     procedure LoadAnyProperty(PropInfo: PPropInfo);
  97.     procedure StoreProperties(PropList: TStrings);
  98.     procedure LoadProperties(PropList: TStrings);
  99.     procedure LoadObjectsProps(AComponent: TComponent; StoredList: TStrings);
  100.     procedure StoreObjectsProps(AComponent: TComponent; StoredList: TStrings);
  101.     property AObject: TObject read FObject write FObject;
  102.     property Prefix: string read FPrefix write FPrefix;
  103.     property Section: string read FSection write FSection;
  104.     property OnReadString: TReadStrEvent read FOnReadString write FOnReadString;
  105.     property OnWriteString: TWriteStrEvent read FOnWriteString write FOnWriteString;
  106.     property OnEraseSection: TEraseSectEvent read FOnEraseSection write FOnEraseSection;
  107.   end;
  108.  
  109. { Utility routines }
  110.  
  111. procedure UpdateStoredList(AComponent: TComponent; AStoredList: TStrings; FromForm: Boolean);
  112. function CreateStoredItem(const CompName, PropName: string): string;
  113. function ParseStoredItem(const Item: string; var CompName, PropName: string): Boolean;
  114.  
  115. const
  116. {$IFDEF WIN32}
  117.   sPropNameDelimiter: string = '_';
  118. {$ELSE}
  119.   sPropNameDelimiter: Char = '_';
  120. {$ENDIF}
  121.  
  122. implementation
  123.  
  124. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, Str16, {$ENDIF}
  125.   Consts, rxStrUtils;
  126.  
  127. const
  128.   sCount = 'Count';
  129.   sItem = 'Item%d';
  130.   sNull = '(null)';
  131.  
  132. type
  133.   TCardinalSet = set of 0..SizeOf(Cardinal) * 8 - 1;
  134.  
  135. {$IFNDEF WIN32}
  136. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  137. begin
  138.   Result := TypInfo.GetEnumName(TypeInfo, Value)^;
  139. end;
  140. {$ENDIF}
  141.  
  142. function GetPropType(PropInfo: PPropInfo): PTypeInfo;
  143. begin
  144. {$IFDEF RX_D3}
  145.   Result := PropInfo^.PropType^;
  146. {$ELSE}
  147.   Result := PropInfo^.PropType;
  148. {$ENDIF}
  149. end;
  150.  
  151. { TPropInfoList }
  152.  
  153. constructor TPropInfoList.Create(AObject: TObject; Filter: TTypeKinds);
  154. begin
  155.   if AObject <> nil then begin
  156.     FCount := GetPropList(AObject.ClassInfo, Filter, nil);
  157.     FSize := FCount * SizeOf(Pointer);
  158.     GetMem(FList, FSize);
  159.     GetPropList(AObject.ClassInfo, Filter, FList);
  160.   end
  161.   else begin
  162.     FCount := 0;
  163.     FList := nil;
  164.   end;
  165. end;
  166.  
  167. destructor TPropInfoList.Destroy;
  168. begin
  169.   if FList <> nil then FreeMem(FList, FSize);
  170. end;
  171.  
  172. function TPropInfoList.Contains(P: PPropInfo): Boolean;
  173. var
  174.   I: Integer;
  175. begin
  176.   for I := 0 to FCount - 1 do
  177.     with FList^[I]^ do
  178.       if (PropType = P^.PropType) and (CompareText(Name, P^.Name) = 0) then
  179.       begin
  180.         Result := True;
  181.         Exit;
  182.       end;
  183.   Result := False;
  184. end;
  185.  
  186. function TPropInfoList.Find(const AName: string): PPropInfo;
  187. var
  188.   I: Integer;
  189. begin
  190.   for I := 0 to FCount - 1 do
  191.     with FList^[I]^ do
  192.       if (CompareText(Name, AName) = 0) then
  193.       begin
  194.         Result := FList^[I];
  195.         Exit;
  196.       end;
  197.   Result := nil;
  198. end;
  199.  
  200. procedure TPropInfoList.Delete(Index: Integer);
  201. begin
  202.   Dec(FCount);
  203.   if Index < FCount then Move(FList^[Index + 1], FList^[Index],
  204.     (FCount - Index) * SizeOf(Pointer));
  205. end;
  206.  
  207. function TPropInfoList.Get(Index: Integer): PPropInfo;
  208. begin
  209.   Result := FList^[Index];
  210. end;
  211.  
  212. procedure TPropInfoList.Intersect(List: TPropInfoList);
  213. var
  214.   I: Integer;
  215. begin
  216.   for I := FCount - 1 downto 0 do
  217.     if not List.Contains(FList^[I]) then Delete(I);
  218. end;
  219.  
  220. { Utility routines }
  221.  
  222. function CreateStoredItem(const CompName, PropName: string): string;
  223. begin
  224.   Result := '';
  225.   if (CompName <> '') and (PropName <> '') then
  226.     Result := CompName + '.' + PropName;
  227. end;
  228.  
  229. function ParseStoredItem(const Item: string; var CompName, PropName: string): Boolean;
  230. var
  231.   I: Integer;
  232. begin
  233.   Result := False;
  234.   if Length(Item) = 0 then Exit;
  235.   I := Pos('.', Item);
  236.   if I > 0 then begin
  237.     CompName := Trim(Copy(Item, 1, I - 1));
  238.     PropName := Trim(Copy(Item, I + 1, MaxInt));
  239.     Result := (Length(CompName) > 0) and (Length(PropName) > 0);
  240.   end;
  241. end;
  242.  
  243. function ReplaceComponentName(const Item, CompName: string): string;
  244. var
  245.   ACompName, APropName: string;
  246. begin
  247.   Result := '';
  248.   if ParseStoredItem(Item, ACompName, APropName) then
  249.     Result := CreateStoredItem(CompName, APropName);
  250. end;
  251.  
  252. procedure UpdateStoredList(AComponent: TComponent; AStoredList: TStrings; FromForm: Boolean);
  253. var
  254.   I: Integer;
  255.   Component: TComponent;
  256.   CompName, PropName: string;
  257. begin
  258.   if (AStoredList = nil) or (AComponent = nil) then Exit;
  259.   for I := AStoredList.Count - 1 downto 0 do begin
  260.     if ParseStoredItem(AStoredList[I], CompName, PropName) then
  261.     begin
  262.       if FromForm then begin
  263.         Component := AComponent.FindComponent(CompName);
  264.         if Component = nil then AStoredList.Delete(I)
  265.         else AStoredList.Objects[I] := Component;
  266.       end
  267.       else begin
  268.         Component := TComponent(AStoredList.Objects[I]);
  269.         if Component <> nil then
  270.           AStoredList[I] := ReplaceComponentName(AStoredList[I], Component.Name)
  271.         else AStoredList.Delete(I);
  272.       end;
  273.     end
  274.     else AStoredList.Delete(I);
  275.   end;
  276. end;
  277.  
  278. {$IFDEF WIN32}
  279. function FindGlobalComponent(const Name: string): TComponent;
  280. var
  281.   I: Integer;
  282. begin
  283.   for I := 0 to Screen.FormCount - 1 do begin
  284.     Result := Screen.Forms[I];
  285.     if CompareText(Name, Result.Name) = 0 then Exit;
  286.   end;
  287.   for I := 0 to Screen.DataModuleCount - 1 do begin
  288.     Result := Screen.DataModules[I];
  289.     if CompareText(Name, Result.Name) = 0 then Exit;
  290.   end;
  291.   Result := nil;
  292. end;
  293. {$ENDIF}
  294.  
  295. { TPropsStorage }
  296.  
  297. function TPropsStorage.GetItemName(const APropName: string): string;
  298. begin
  299.   Result := Prefix + APropName;
  300. end;
  301.  
  302. procedure TPropsStorage.LoadAnyProperty(PropInfo: PPropInfo);
  303. var
  304.   S, Def: string;
  305. begin
  306.   try
  307.     if PropInfo <> nil then begin
  308.       case PropInfo^.PropType^.Kind of
  309.         tkInteger: Def := StoreIntegerProperty(PropInfo);
  310.         tkChar: Def := StoreCharProperty(PropInfo);
  311.         tkEnumeration: Def := StoreEnumProperty(PropInfo);
  312.         tkFloat: Def := StoreFloatProperty(PropInfo);
  313. {$IFDEF WIN32}
  314.         tkWChar: Def := StoreWCharProperty(PropInfo);
  315.         tkLString: Def := StoreLStringProperty(PropInfo);
  316.   {$IFNDEF RX_D3} { - Delphi 2.0, C++Builder 1.0 }
  317.         tkLWString: Def := StoreLStringProperty(PropInfo);
  318.   {$ENDIF}
  319.         tkVariant: Def := StoreVariantProperty(PropInfo);
  320. {$ENDIF WIN32}
  321. {$IFDEF RX_D4}
  322.         tkInt64: Def := StoreInt64Property(PropInfo);
  323. {$ENDIF}
  324.         tkString: Def := StoreStringProperty(PropInfo);
  325.         tkSet: Def := StoreSetProperty(PropInfo);
  326.         tkClass: Def := '';
  327.         else Exit;
  328.       end;
  329.       if (Def <> '') or (PropInfo^.PropType^.Kind in [tkString, tkClass])
  330. {$IFDEF WIN32}
  331.         or (PropInfo^.PropType^.Kind in [tkLString,
  332.           {$IFNDEF RX_D3} tkLWString, {$ENDIF} tkWChar])
  333. {$ENDIF WIN32}
  334.       then
  335.         S := Trim(ReadString(Section, GetItemName(PropInfo^.Name), Def))
  336.       else S := '';
  337.       case PropInfo^.PropType^.Kind of
  338.         tkInteger: LoadIntegerProperty(S, PropInfo);
  339.         tkChar: LoadCharProperty(S, PropInfo);
  340.         tkEnumeration: LoadEnumProperty(S, PropInfo);
  341.         tkFloat: LoadFloatProperty(S, PropInfo);
  342. {$IFDEF WIN32}
  343.         tkWChar: LoadWCharProperty(S, PropInfo);
  344.         tkLString: LoadLStringProperty(S, PropInfo);
  345.   {$IFNDEF RX_D3} { - Delphi 2.0, C++Builder 1.0 }
  346.         tkLWString: LoadLStringProperty(S, PropInfo);
  347.   {$ENDIF}
  348.         tkVariant: LoadVariantProperty(S, PropInfo);
  349. {$ENDIF WIN32}
  350. {$IFDEF RX_D4}
  351.         tkInt64: LoadInt64Property(S, PropInfo);
  352. {$ENDIF}
  353.         tkString: LoadStringProperty(S, PropInfo);
  354.         tkSet: LoadSetProperty(S, PropInfo);
  355.         tkClass: LoadClassProperty(S, PropInfo);
  356.       end;
  357.     end;
  358.   except
  359.     { ignore any exception }
  360.   end;
  361. end;
  362.  
  363. procedure TPropsStorage.StoreAnyProperty(PropInfo: PPropInfo);
  364. var
  365.   S: string;
  366. begin
  367.   if PropInfo <> nil then begin
  368.     case PropInfo^.PropType^.Kind of
  369.       tkInteger: S := StoreIntegerProperty(PropInfo);
  370.       tkChar: S := StoreCharProperty(PropInfo);
  371.       tkEnumeration: S := StoreEnumProperty(PropInfo);
  372.       tkFloat: S := StoreFloatProperty(PropInfo);
  373. {$IFDEF WIN32}
  374.       tkLString: S := StoreLStringProperty(PropInfo);
  375.   {$IFNDEF RX_D3} { - Delphi 2.0, C++Builder 1.0 }
  376.       tkLWString: S := StoreLStringProperty(PropInfo);
  377.   {$ENDIF}
  378.       tkWChar: S := StoreWCharProperty(PropInfo);
  379.       tkVariant: S := StoreVariantProperty(PropInfo);
  380. {$ENDIF WIN32}
  381. {$IFDEF RX_D4}
  382.       tkInt64: S := StoreInt64Property(PropInfo);
  383. {$ENDIF}
  384.       tkString: S := StoreStringProperty(PropInfo);
  385.       tkSet: S := StoreSetProperty(PropInfo);
  386.       tkClass: S := StoreClassProperty(PropInfo);
  387.       else Exit;
  388.     end;
  389.     if (S <> '') or (PropInfo^.PropType^.Kind in [tkString
  390.       {$IFDEF WIN32}, tkLString, {$IFNDEF RX_D3} tkLWString, {$ENDIF}
  391.       tkWChar {$ENDIF WIN32}]) then
  392.       WriteString(Section, GetItemName(PropInfo^.Name), Trim(S));
  393.   end;
  394. end;
  395.  
  396. function TPropsStorage.StoreIntegerProperty(PropInfo: PPropInfo): string;
  397. begin
  398.   Result := IntToStr(GetOrdProp(FObject, PropInfo));
  399. end;
  400.  
  401. function TPropsStorage.StoreCharProperty(PropInfo: PPropInfo): string;
  402. begin
  403.   Result := Char(GetOrdProp(FObject, PropInfo));
  404. end;
  405.  
  406. function TPropsStorage.StoreEnumProperty(PropInfo: PPropInfo): string;
  407. begin
  408.   Result := GetEnumName(GetPropType(PropInfo), GetOrdProp(FObject, PropInfo));
  409. end;
  410.  
  411. function TPropsStorage.StoreFloatProperty(PropInfo: PPropInfo): string;
  412. const
  413. {$IFDEF WIN32}
  414.   Precisions: array[TFloatType] of Integer = (7, 15, 18, 18, 19);
  415. {$ELSE}
  416.   Precisions: array[TFloatType] of Integer = (7, 15, 18, 18);
  417. {$ENDIF}
  418. begin
  419.   Result := ReplaceStr(FloatToStrF(GetFloatProp(FObject, PropInfo), ffGeneral,
  420.     Precisions[GetTypeData(GetPropType(PropInfo))^.FloatType], 0), 
  421.     DecimalSeparator, '.');
  422. end;
  423.  
  424. function TPropsStorage.StoreStringProperty(PropInfo: PPropInfo): string;
  425. begin
  426.   Result := GetStrProp(FObject, PropInfo);
  427. end;
  428.  
  429. {$IFDEF WIN32}
  430. function TPropsStorage.StoreLStringProperty(PropInfo: PPropInfo): string;
  431. begin
  432.   Result := GetStrProp(FObject, PropInfo);
  433. end;
  434.  
  435. function TPropsStorage.StoreWCharProperty(PropInfo: PPropInfo): string;
  436. begin
  437.   Result := Char(GetOrdProp(FObject, PropInfo));
  438. end;
  439.  
  440. function TPropsStorage.StoreVariantProperty(PropInfo: PPropInfo): string;
  441. begin
  442.   Result := GetVariantProp(FObject, PropInfo);
  443. end;
  444. {$ENDIF}
  445.  
  446. {$IFDEF RX_D4}
  447. function TPropsStorage.StoreInt64Property(PropInfo: PPropInfo): string;
  448. begin
  449.   Result := IntToStr(GetInt64Prop(FObject, PropInfo));
  450. end;
  451. {$ENDIF}
  452.  
  453. function TPropsStorage.StoreSetProperty(PropInfo: PPropInfo): string;
  454. var
  455.   TypeInfo: PTypeInfo;
  456.   W: Cardinal;
  457.   I: Integer;
  458. begin
  459.   Result := '[';
  460.   W := GetOrdProp(FObject, PropInfo);
  461.   TypeInfo := GetTypeData(GetPropType(PropInfo))^.CompType{$IFDEF RX_D3}^{$ENDIF};
  462.   for I := 0 to SizeOf(TCardinalSet) * 8 - 1 do
  463.     if I in TCardinalSet(W) then begin
  464.       if Length(Result) <> 1 then Result := Result + ',';
  465.       Result := Result + GetEnumName(TypeInfo, I);
  466.     end;
  467.   Result := Result + ']';
  468. end;
  469.  
  470. function TPropsStorage.StoreStringsProperty(PropInfo: PPropInfo): string;
  471. var
  472.   List: TObject;
  473.   I: Integer;
  474.   SectName: string;
  475. begin
  476.   Result := '';
  477.   List := TObject(GetOrdProp(Self.FObject, PropInfo));
  478.   SectName := Format('%s.%s', [Section, GetItemName(PropInfo^.Name)]);
  479.   EraseSection(SectName);
  480.   if (List is TStrings) and (TStrings(List).Count > 0) then begin
  481.     WriteString(SectName, sCount, IntToStr(TStrings(List).Count));
  482.     for I := 0 to TStrings(List).Count - 1 do
  483.       WriteString(SectName, Format(sItem, [I]), TStrings(List)[I]);
  484.   end;
  485. end;
  486.  
  487. function TPropsStorage.StoreComponentProperty(PropInfo: PPropInfo): string;
  488. var
  489.   Comp: TComponent;
  490.   RootName: string;
  491. begin
  492.   Comp := TComponent(GetOrdProp(FObject, PropInfo));
  493.   if Comp <> nil then begin
  494.     Result := Comp.Name;
  495.     if (Comp.Owner <> nil) and (Comp.Owner <> FOwner) then begin
  496.       RootName := Comp.Owner.Name;
  497.       if RootName = '' then begin
  498.         RootName := Comp.Owner.ClassName;
  499.         if (RootName <> '') and (UpCase(RootName[1]) = 'T') then
  500.           Delete(RootName, 1, 1);
  501.       end;
  502.       Result := Format('%s.%s', [RootName, Result]);
  503.     end;
  504.   end
  505.   else Result := sNull;
  506. end;
  507.  
  508. function TPropsStorage.StoreClassProperty(PropInfo: PPropInfo): string;
  509. var
  510.   Saver: TPropsStorage;
  511.   I: Integer;
  512.   Obj: TObject;
  513.  
  514.   procedure StoreObjectProps(Obj: TObject; const APrefix, ASection: string);
  515.   var
  516.     I: Integer;
  517.     Props: TPropInfoList;
  518.   begin
  519.     with Saver do begin
  520.       AObject := Obj;
  521.       Prefix := APrefix;
  522.       Section := ASection;
  523.       FOnWriteString := Self.FOnWriteString;
  524.       FOnEraseSection := Self.FOnEraseSection;
  525.       Props := TPropInfoList.Create(AObject, tkProperties);
  526.       try
  527.         for I := 0 to Props.Count - 1 do StoreAnyProperty(Props.Items[I]);
  528.       finally
  529.         Props.Free;
  530.       end;
  531.     end;
  532.   end;
  533.  
  534. begin
  535.   Result := '';
  536.   Obj := TObject(GetOrdProp(Self.FObject, PropInfo));
  537.   if (Obj <> nil) then begin
  538.     if Obj is TStrings then StoreStringsProperty(PropInfo)
  539. {$IFDEF WIN32}
  540.     else if Obj is TCollection then begin
  541.       EraseSection(Format('%s.%s', [Section, Prefix + PropInfo^.Name]));
  542.       Saver := CreateStorage;
  543.       try
  544.         WriteString(Section, Format('%s.%s', [Prefix + PropInfo^.Name, sCount]),
  545.           IntToStr(TCollection(Obj).Count));
  546.         for I := 0 to TCollection(Obj).Count - 1 do begin
  547.           StoreObjectProps(TCollection(Obj).Items[I],
  548.             Format(sItem, [I]) + sPropNameDelimiter,
  549.             Format('%s.%s', [Section, Prefix + PropInfo^.Name]));
  550.         end;
  551.       finally
  552.         Saver.Free;
  553.       end;
  554.     end
  555. {$ENDIF}
  556.     else if Obj is TComponent then begin
  557.       Result := StoreComponentProperty(PropInfo);
  558.       Exit;
  559.     end;
  560.   end;
  561.   Saver := CreateStorage;
  562.   try
  563.     with Saver do begin
  564.       StoreObjectProps(Obj, Self.Prefix + PropInfo^.Name, Self.Section);
  565.     end;
  566.   finally
  567.     Saver.Free;
  568.   end;
  569. end;
  570.  
  571. procedure TPropsStorage.LoadIntegerProperty(const S: string; PropInfo: PPropInfo);
  572. begin
  573.   SetOrdProp(FObject, PropInfo, StrToIntDef(S, 0));
  574. end;
  575.  
  576. procedure TPropsStorage.LoadCharProperty(const S: string; PropInfo: PPropInfo);
  577. begin
  578.   SetOrdProp(FObject, PropInfo, Integer(S[1]));
  579. end;
  580.  
  581. procedure TPropsStorage.LoadEnumProperty(const S: string; PropInfo: PPropInfo);
  582. var
  583.   I: Integer;
  584.   EnumType: PTypeInfo;
  585. begin
  586.   EnumType := GetPropType(PropInfo);
  587.   with GetTypeData(EnumType)^ do
  588.     for I := MinValue to MaxValue do
  589.       if CompareText(GetEnumName(EnumType, I), S) = 0 then
  590.       begin
  591.         SetOrdProp(FObject, PropInfo, I);
  592.         Exit;
  593.       end;
  594. end;
  595.  
  596. procedure TPropsStorage.LoadFloatProperty(const S: string; PropInfo: PPropInfo);
  597. begin
  598.   SetFloatProp(FObject, PropInfo, StrToFloat(ReplaceStr(S, '.',
  599.     DecimalSeparator)));
  600. end;
  601.  
  602. {$IFDEF RX_D4}
  603. procedure TPropsStorage.LoadInt64Property(const S: string; PropInfo: PPropInfo);
  604. begin
  605.   SetInt64Prop(FObject, PropInfo, StrToInt64Def(S, 0));
  606. end;
  607. {$ENDIF}
  608.  
  609. {$IFDEF WIN32}
  610. procedure TPropsStorage.LoadLStringProperty(const S: string; PropInfo: PPropInfo);
  611. begin
  612.   SetStrProp(FObject, PropInfo, S);
  613. end;
  614.  
  615. procedure TPropsStorage.LoadWCharProperty(const S: string; PropInfo: PPropInfo);
  616. begin
  617.   SetOrdProp(FObject, PropInfo, Longint(S[1]));
  618. end;
  619.  
  620. procedure TPropsStorage.LoadVariantProperty(const S: string; PropInfo: PPropInfo);
  621. begin
  622.   SetVariantProp(FObject, PropInfo, S);
  623. end;
  624. {$ENDIF}
  625.  
  626. procedure TPropsStorage.LoadStringProperty(const S: string; PropInfo: PPropInfo);
  627. begin
  628.   SetStrProp(FObject, PropInfo, S);
  629. end;
  630.  
  631. procedure TPropsStorage.LoadSetProperty(const S: string; PropInfo: PPropInfo);
  632. const
  633.   Delims = [' ', ',', '[', ']'];
  634. var
  635.   TypeInfo: PTypeInfo;
  636.   W: Cardinal;
  637.   I, N: Integer;
  638.   Count: Integer;
  639.   EnumName: string;
  640. begin
  641.   W := 0;
  642.   TypeInfo := GetTypeData(GetPropType(PropInfo))^.CompType{$IFDEF RX_D3}^{$ENDIF};
  643.   Count := WordCount(S, Delims);
  644.   for N := 1 to Count do begin
  645.     EnumName := ExtractWord(N, S, Delims);
  646.     try
  647.       I := GetEnumValue(TypeInfo, EnumName);
  648.       if I >= 0 then Include(TCardinalSet(W), I);
  649.     except
  650.     end;
  651.   end;
  652.   SetOrdProp(FObject, PropInfo, W);
  653. end;
  654.  
  655. procedure TPropsStorage.LoadStringsProperty(const S: string; PropInfo: PPropInfo);
  656. var
  657.   List: TObject;
  658.   Temp: TStrings;
  659.   I, Cnt: Integer;
  660.   SectName: string;
  661. begin
  662.   List := TObject(GetOrdProp(Self.FObject, PropInfo));
  663.   if (List is TStrings) then begin
  664.     SectName := Format('%s.%s', [Section, GetItemName(PropInfo^.Name)]);
  665.     Cnt := StrToIntDef(Trim(ReadString(SectName, sCount, '0')), 0);
  666.     if Cnt > 0 then begin
  667.       Temp := TStringList.Create;
  668.       try
  669.         for I := 0 to Cnt - 1 do
  670.           Temp.Add(ReadString(SectName, Format(sItem, [I]), ''));
  671.         TStrings(List).Assign(Temp);
  672.       finally
  673.         Temp.Free;
  674.       end;
  675.     end;
  676.   end;
  677. end;
  678.  
  679. procedure TPropsStorage.LoadComponentProperty(const S: string; PropInfo: PPropInfo);
  680. {$IFDEF WIN32}
  681. var
  682.   RootName, Name: string;
  683.   Root: TComponent;
  684.   P: Integer;
  685. begin
  686.   if Trim(S) = '' then Exit;
  687.   if CompareText(SNull, Trim(S)) = 0 then begin
  688.     SetOrdProp(FObject, PropInfo, Longint(nil));
  689.     Exit;
  690.   end;
  691.   P := Pos('.', S);
  692.   if P > 0 then begin
  693.     RootName := Trim(Copy(S, 1, P - 1));
  694.     Name := Trim(Copy(S, P + 1, MaxInt));
  695.   end
  696.   else begin
  697.     RootName := '';
  698.     Name := Trim(S);
  699.   end;
  700.   if RootName <> '' then Root := FindGlobalComponent(RootName)
  701.   else Root := FOwner;
  702.   if (Root <> nil) then
  703.     SetOrdProp(FObject, PropInfo, Longint(Root.FindComponent(Name)));
  704. end;
  705. {$ELSE}
  706. begin
  707.   if Trim(S) = '' then Exit;
  708.   if CompareText(SNull, Trim(S)) = 0 then begin
  709.     SetOrdProp(FObject, PropInfo, Longint(nil));
  710.     Exit;
  711.   end;
  712.   if (FOwner <> nil) then
  713.     SetOrdProp(FObject, PropInfo, Longint(FOwner.FindComponent(Trim(S))));
  714. end;
  715. {$ENDIF}
  716.  
  717. procedure TPropsStorage.LoadClassProperty(const S: string; PropInfo: PPropInfo);
  718. var
  719.   Loader: TPropsStorage;
  720.   I: Integer;
  721. {$IFDEF WIN32}
  722.   Cnt: Integer;
  723.   Recreate: Boolean;
  724. {$ENDIF}
  725.   Obj: TObject;
  726.  
  727.   procedure LoadObjectProps(Obj: TObject; const APrefix, ASection: string);
  728.   var
  729.     I: Integer;
  730.     Props: TPropInfoList;
  731.   begin
  732.     with Loader do begin
  733.       AObject := Obj;
  734.       Prefix := APrefix;
  735.       Section := ASection;
  736.       FOnReadString := Self.FOnReadString;
  737.       Props := TPropInfoList.Create(AObject, tkProperties);
  738.       try
  739.         for I := 0 to Props.Count - 1 do LoadAnyProperty(Props.Items[I]);
  740.       finally
  741.         Props.Free;
  742.       end;
  743.     end;
  744.   end;
  745.  
  746. begin
  747.   Obj := TObject(GetOrdProp(Self.FObject, PropInfo));
  748.   if (Obj <> nil) then begin
  749.     if Obj is TStrings then LoadStringsProperty(S, PropInfo)
  750. {$IFDEF WIN32}
  751.     else if Obj is TCollection then begin
  752.       Loader := CreateStorage;
  753.       try
  754.         Cnt := TCollection(Obj).Count;
  755.         Cnt := StrToIntDef(ReadString(Section, Format('%s.%s',
  756.           [Prefix + PropInfo^.Name, sCount]), IntToStr(Cnt)), Cnt);
  757.         Recreate := TCollection(Obj).Count <> Cnt;
  758.         TCollection(Obj).BeginUpdate;
  759.         try
  760.           if Recreate then TCollection(Obj).Clear;
  761.           for I := 0 to Cnt - 1 do begin
  762.             if Recreate then TCollection(Obj).Add;
  763.             LoadObjectProps(TCollection(Obj).Items[I],
  764.               Format(sItem, [I]) + sPropNameDelimiter,
  765.               Format('%s.%s', [Section, Prefix + PropInfo^.Name]));
  766.           end;
  767.         finally
  768.           TCollection(Obj).EndUpdate;
  769.         end;
  770.       finally
  771.         Loader.Free;
  772.       end;
  773.     end
  774. {$ENDIF}
  775.     else if Obj is TComponent then begin
  776.       LoadComponentProperty(S, PropInfo);
  777.       Exit;
  778.     end;
  779.   end;
  780.   Loader := CreateStorage;
  781.   try
  782.     LoadObjectProps(Obj, Self.Prefix + PropInfo^.Name, Self.Section);
  783.   finally
  784.     Loader.Free;
  785.   end;
  786. end;
  787.  
  788. procedure TPropsStorage.StoreProperties(PropList: TStrings);
  789. var
  790.   I: Integer;
  791.   Props: TPropInfoList;
  792. begin
  793.   Props := TPropInfoList.Create(AObject, tkProperties);
  794.   try
  795.     for I := 0 to PropList.Count - 1 do
  796.       StoreAnyProperty(Props.Find(PropList[I]));
  797.   finally
  798.     Props.Free;
  799.   end;
  800. end;
  801.  
  802. procedure TPropsStorage.LoadProperties(PropList: TStrings);
  803. var
  804.   I: Integer;
  805.   Props: TPropInfoList;
  806. begin
  807.   Props := TPropInfoList.Create(AObject, tkProperties);
  808.   try
  809.     for I := 0 to PropList.Count - 1 do
  810.       LoadAnyProperty(Props.Find(PropList[I]));
  811.   finally
  812.     Props.Free;
  813.   end;
  814. end;
  815.  
  816. function TPropsStorage.CreateInfoList(AComponent: TComponent; StoredList: TStrings): TStrings;
  817. var
  818.   I: Integer;
  819.   Obj: TComponent;
  820.   Props: TPropInfoList;
  821. begin
  822.   UpdateStoredList(AComponent, StoredList, False);
  823.   Result := TStringList.Create;
  824.   try
  825.     TStringList(Result).Sorted := True;
  826.     for I := 0 to StoredList.Count - 1 do begin
  827.       Obj := TComponent(StoredList.Objects[I]);
  828.       if Result.IndexOf(Obj.Name) < 0 then begin
  829.         Props := TPropInfoList.Create(Obj, tkProperties);
  830.         try
  831.           Result.AddObject(Obj.Name, Props);
  832.         except
  833.           Props.Free;
  834.           raise;
  835.         end;
  836.       end;
  837.     end;
  838.   except
  839.     Result.Free;
  840.     Result := nil;
  841.   end;
  842. end;
  843.  
  844. procedure TPropsStorage.FreeInfoLists(Info: TStrings);
  845. var
  846.   I: Integer;
  847. begin
  848.   for I := Info.Count - 1 downto 0 do Info.Objects[I].Free;
  849.   Info.Free;
  850. end;
  851.  
  852. procedure TPropsStorage.LoadObjectsProps(AComponent: TComponent; StoredList: TStrings);
  853. var
  854.   Info: TStrings;
  855.   I, Idx: Integer;
  856.   Props: TPropInfoList;
  857.   CompName, PropName: string;
  858. begin
  859.   Info := CreateInfoList(AComponent, StoredList);
  860.   if Info <> nil then
  861.   try
  862.     FOwner := AComponent;
  863.     for I := 0 to StoredList.Count - 1 do begin
  864.       if ParseStoredItem(StoredList[I], CompName, PropName) then begin
  865.         AObject := StoredList.Objects[I];
  866.         Prefix := TComponent(AObject).Name;
  867.         Idx := Info.IndexOf(Prefix);
  868.         if Idx >= 0 then begin
  869.           Prefix := Prefix + sPropNameDelimiter;
  870.           Props := TPropInfoList(Info.Objects[Idx]);
  871.           if Props <> nil then LoadAnyProperty(Props.Find(PropName));
  872.         end;
  873.       end;
  874.     end;
  875.   finally
  876.     FOwner := nil;
  877.     FreeInfoLists(Info);
  878.   end;
  879. end;
  880.  
  881. procedure TPropsStorage.StoreObjectsProps(AComponent: TComponent; StoredList: TStrings);
  882. var
  883.   Info: TStrings;
  884.   I, Idx: Integer;
  885.   Props: TPropInfoList;
  886.   CompName, PropName: string;
  887. begin
  888.   Info := CreateInfoList(AComponent, StoredList);
  889.   if Info <> nil then
  890.   try
  891.     FOwner := AComponent;
  892.     for I := 0 to StoredList.Count - 1 do begin
  893.       if ParseStoredItem(StoredList[I], CompName, PropName) then begin
  894.         AObject := StoredList.Objects[I];
  895.         Prefix := TComponent(AObject).Name;
  896.         Idx := Info.IndexOf(Prefix);
  897.         if Idx >= 0 then begin
  898.           Prefix := Prefix + sPropNameDelimiter;
  899.           Props := TPropInfoList(Info.Objects[Idx]);
  900.           if Props <> nil then StoreAnyProperty(Props.Find(PropName));
  901.         end;
  902.       end;
  903.     end;
  904.   finally
  905.     FOwner := nil;
  906.     FreeInfoLists(Info);
  907.   end;
  908. end;
  909.  
  910. function TPropsStorage.CreateStorage: TPropsStorage;
  911. begin
  912.   Result := TPropsStorage.Create;
  913. end;
  914.  
  915. function TPropsStorage.ReadString(const ASection, Item, Default: string): string;
  916. begin
  917.   if Assigned(FOnReadString) then Result := FOnReadString(ASection, Item, Default)
  918.   else Result := '';
  919. end;
  920.  
  921. procedure TPropsStorage.WriteString(const ASection, Item, Value: string);
  922. begin
  923.   if Assigned(FOnWriteString) then FOnWriteString(ASection, Item, Value);
  924. end;
  925.  
  926. procedure TPropsStorage.EraseSection(const ASection: string);
  927. begin
  928.   if Assigned(FOnEraseSection) then FOnEraseSection(ASection);
  929. end;
  930.  
  931. end.